home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / programr / wtj201.zip / DUMPLDT.ZIP / DUMPLDT.PAS < prev   
Pascal/Delphi Source File  |  1992-11-06  |  9KB  |  334 lines
  1. {$S-,R-,V-,I-,B-,F-,W-,A-,G-,X+,N-}
  2. {****************************************************}
  3. {*                DUMPLDT.PAS 1.00                  *}
  4. {*             by Richard S. Sadowsky                }
  5. {****************************************************}
  6. program DumpLDT;
  7.   {-Dumps the Local Descriptor Table.}
  8. uses
  9.   WinTypes, WinProcs, WinDos, Strings,
  10.   {$IFDEF VER70}
  11.     Objects, OWindows, ODialogs,
  12.   {$ELSE}
  13.     WObjects, StdDlgs,
  14.   {$ENDIF}
  15.   ToolHelp;
  16. type
  17.   DescriptorTableEntry =
  18.     record
  19.       LimitL : Word;
  20.       BaseL  : Word;
  21.       Words : Array[0..1] of Word;
  22.     end;
  23.   Long =
  24.     record
  25.       LowWord, HighWord : Word;
  26.     end;
  27.  
  28.   PLDTList = ^TLDTList;
  29.   TLDTList = {an LDT "list box"}
  30.     object(TListBox)
  31.       procedure BuildList;
  32.     end;
  33.  
  34.   DumpLDTApplication =
  35.     object(TApplication)
  36.       procedure InitMainWindow; virtual;
  37.     end;
  38.   PLDTWindow = ^LDTWindow;
  39.   LDTWindow =
  40.     object(TWindow)
  41.       LDTLB : PLDTList;
  42.       constructor Init(AParent : PWindowsObject; ATitle : PChar);
  43.       procedure SetupWindow; virtual;
  44.       procedure WMActivateApp(var Msg : TMessage);
  45.         virtual wm_First + wm_ActivateApp;
  46.       procedure wmSetFocus(var Msg : TMessage);
  47.         virtual wm_First+wm_SetFocus;
  48.       procedure wmSize(var Msg : TMessage);
  49.         virtual wm_First+wm_Size;
  50.     end;
  51.  
  52. var
  53.   LDTApp : DumpLDTApplication;
  54.  
  55. const
  56.   Digits : array[0..$F] of Char = '0123456789ABCDEF'; {for hex routines}
  57.  
  58.   function GetDescriptor(Selector : Word; var Descriptor : DescriptorTableEntry) : Word; Assembler;
  59.     {-DPMI Get Descriptor function. Returns 0 on success.}
  60.   asm
  61.     mov     ax,000Bh
  62.     mov     bx,Selector
  63.     les     di,Descriptor
  64.     int     31h
  65.     jc      @@ExitPoint
  66.     xor     ax,ax
  67.   @@ExitPoint:
  68.   end;
  69.  
  70.   function Long2Str(Dest : PChar; L : LongInt) : PChar;
  71.     {-Convert a long/word/integer/byte/shortint to a string}
  72.   var
  73.     S : string;
  74.   begin
  75.     Str(L, S);
  76.     Long2Str := StrPCopy(Dest, S);
  77.   end;
  78.  
  79.   function HexB(Dest : PChar; B : Byte) : PChar;
  80.     {-Return hex string for byte}
  81.   begin
  82.     HexB := Dest;
  83.     Dest^ := Digits[B shr 4];
  84.     Inc(Dest);
  85.     Dest^ := Digits[B and $F];
  86.     Inc(Dest);
  87.     Dest^ := #0;
  88.   end;
  89.  
  90.   function HexW(Dest : PChar; W : Word) : PChar;
  91.     {-Return hex string for word}
  92.   begin
  93.     HexW := Dest;
  94.     Dest^ := Digits[hi(W) shr 4];
  95.     Inc(Dest);
  96.     Dest^ := Digits[hi(W) and $F];
  97.     Inc(Dest);
  98.     Dest^ := Digits[lo(W) shr 4];
  99.     Inc(Dest);
  100.     Dest^ := Digits[lo(W) and $F];
  101.     Inc(Dest);
  102.     Dest^ := #0;
  103.   end;
  104.  
  105.   function HexL(Dest : PChar; L : LongInt) : PChar;
  106.     {-Return hex string for LongInt}
  107.   var
  108.     T2 : Array[0..4] of Char;
  109.   begin
  110.     with Long(L) do
  111.       HexL := StrCat(HexW(Dest, HighWord), HexW(T2, LowWord));
  112.   end;
  113.  
  114.   function LeftPad(S : PChar; Len : Word) : PChar; Assembler;
  115.     {-Return a string left-padded to length len with spaces}
  116.   asm
  117.     les     di,S
  118.     mov     dx,es
  119.     mov     bx,di
  120.     cld
  121.     xor     al,al
  122.     mov     cx,0FFFFh
  123.     repne   scasb
  124.     not     cx
  125.     dec     cx
  126.     mov     ax,Len
  127.     sub     ax,cx
  128.     jbe     @@ExitPoint
  129.     push    ds
  130.     mov     ds,dx
  131.     mov     si,bx
  132.     mov     di,bx
  133.     std
  134.     add     si,cx
  135.     add     di,Len
  136.     inc     cx
  137.     rep     movsb
  138.     mov     cx,ax
  139.     mov     al,' '
  140.     rep     stosb
  141.     pop     ds
  142.   @@ExitPoint:
  143.     cld
  144.     mov     ax,bx
  145.   end;
  146.  
  147.   constructor LDTWindow.Init(AParent : PWindowsObject; ATitle : PChar);
  148.     {-Initialize our main window}
  149.   begin
  150.     TWindow.Init(AParent, ATitle);
  151.     with Attr do begin
  152.       W := 450;
  153.       H := 335;
  154.     end;
  155.     LDTLB := New(PLDTList, Init(@Self, 201, 0, 0, 0, 0));
  156.   end;
  157.  
  158.   procedure ParseDesc(var Desc : DescriptorTableEntry; var Base : LongInt; var Limit : LongInt; var TypeOfField : Byte; var DPL : Byte);
  159.     {-Break a descriptor up into its components.}
  160.   begin
  161.     with Desc do begin
  162.       Limit := LongInt(LimitL) or (LongInt(Words[1] and $0F) shl 16);
  163.       Base := LongInt(BaseL) or (LongInt((Words[0] and $00FF) or (Words[1] and $FF00)) shl 16);
  164.       TypeOfField := (Words[0] shr 8) and $0F;
  165.       DPL := (Words[0] shr 13) and $03;
  166.     end;
  167.   end;
  168.  
  169.   function ValidDesc(var Desc : DescriptorTableEntry) : Boolean;
  170.     {-Return True if the descriptor seems valid.}
  171.   var
  172.     Base, Limit : LongInt;
  173.     Typ, DPL : Byte;
  174.   begin
  175.     ParseDesc(Desc, Base, Limit, Typ, DPL);
  176.     ValidDesc := (Typ <> 0) and (Typ <> $F);
  177.   end;
  178.  
  179.   function Desc2Str(Selector : Word; var Desc : DescriptorTableEntry; P : PChar) : Boolean;
  180.     {-Create the line to display in the LDT list box for a selector.}
  181.   var
  182.     Base, Limit : LongInt;
  183.     Typ, DPL : Byte;
  184.     N : Array[0..10] of Char;
  185.   type
  186.     CodeDataStr = Array[0..5] of Char;
  187.     ReadWriteStr = Array[0..4] of Char;
  188.     UpDownStr = Array[0..2] of Char;
  189.     AccessedStr = Array[0..2] of Char;
  190.     LoadedStr = Array[0..3] of Char;
  191.   const
  192.     CodeData : Array[Boolean] of CodeDataStr = (' data', ' code');
  193.     ReadWrite : Array[Boolean] of ReadWriteStr = (' R  ', ' R/W');
  194.     Accessed : Array[Boolean] of AccessedStr = (' N', ' A');
  195.     UpDown : Array[Boolean] of UpDownStr = (' U', ' D');
  196.     Loaded : Array[Boolean] of LoadedStr = (' U ', ' L ');
  197.   begin
  198.     ParseDesc(Desc, Base, Limit, Typ, DPL);
  199.     if (Typ = 0) or (Typ = $F) then begin
  200.       Desc2Str := False;
  201.       Exit;
  202.     end
  203.     else
  204.       Desc2Str := True;
  205.     HexW(P, Selector);
  206.     Long2Str(N, Limit + 1);
  207.     StrCat(P, LeftPad(N, 8));
  208.     StrCat(P, ' ');
  209.     StrCat(P, HexB(N, DPL));
  210.     if Typ and $08 > 0 then begin
  211.       StrCat(P, CodeData[True]);
  212.       StrCat(P, ReadWrite[False]);
  213.       StrCat(P, '  ');
  214.     end
  215.     else begin
  216.       StrCat(P, CodeData[False]);
  217.       StrCat(P, ReadWrite[Typ and $02 > 0]);
  218.       StrCat(P, UpDown[Typ and $04 > 0]);
  219.     end;
  220.     StrCat(P, Accessed[Typ and $01 > 0]);
  221.     StrCat(P, Loaded[Desc.Words[0] and $8000 > 0]);
  222.     StrCat(P, HexL(N, Base));
  223.     StrCat(P, ' ');
  224.   end;
  225.  
  226.   function WinHeapInfo(Sel : Word; S : Pchar) : PChar;
  227.     {-Attempt to get Windows heap info. If successful, build string.}
  228.   type
  229.     GTNameStr = Array[0..9] of Char;
  230.   const
  231.     gtNames : Array[0..10] of gtNameStr = ('Unknown  ', 'DGroup   ', 'Data     ', 'Code         ', 'Task     ', 'Resource ', 'Module   ', 'Free       ', 'Internal ', 'Sentinel ', 'Burger M ');
  232.   var
  233.     Global : ToolHelp.TGlobalEntry;
  234.     Task : TTaskEntry;
  235.     Module : TModuleEntry;
  236.   begin
  237.     WinHeapInfo := S;
  238.     FillChar(Global, SizeOf(Global), 0);
  239.     Global.dwSize := SizeOf(Global);
  240.     if ToolHelp.GlobalEntryHandle(@Global, Sel) then begin
  241.       if Global.wType in [0..10] then
  242.         StrCopy(S, gtNames[Global.wType])
  243.       else
  244.         StrCopy(S, 'Invalid  ');
  245.       FillChar(Task, SizeOf(Task), 0);
  246.       Task.dwSize := SizeOf(Task);
  247.       if TaskFindHandle(@Task, Global.hOwner) then
  248.         StrCat(S, Task.szModule)
  249.       else begin
  250.         FillChar(Module, SizeOf(Module), 0);
  251.         Module.dwSize := SizeOf(Module);
  252.         if ModuleFindHandle(@Module, Global.hOwner) <> 0 then
  253.           StrCat(S, Module.szModule);
  254.       end;
  255.     end
  256.     else
  257.       S[0] := #0;
  258.   end;
  259.  
  260.   function GetItemStr(Dest : PChar; var Desc : DescriptorTableEntry; Sel : Word) : PChar;
  261.     {-Return a string for display in the listbox for the given selector}
  262.   var
  263.     WS : Array[0..40] of Char;
  264.  
  265.   begin
  266.     if Desc2Str(Sel, Desc, Dest) then
  267.       StrCat(Dest, WinHeapInfo(Sel, WS))
  268.     else
  269.       Dest^ := #0;
  270.     GetItemStr := Dest;
  271.   end;
  272.  
  273.   procedure TLDTList.BuildList;
  274.     {-Loop through all selectors finding valid ones to put in listbox.}
  275.   var
  276.     NewCursor, OldCursor : HCursor;
  277.     Index, Sel : Word;
  278.     Desc : DescriptorTableEntry;
  279.     I : Integer;
  280.     DescStr : Array[0..255] of Char;
  281.   begin
  282.     NewCursor := LoadCursor(0, idc_Wait);
  283.     OldCursor := SetCursor(NewCursor);
  284.     ClearList;
  285.     for Index := 0 to $1FFF do begin
  286.       Sel := (Index * 8) or 7;    {calc value for valid LDT selector}
  287.       if GetDescriptor(Sel, Desc) = 0 then
  288.         if ValidDesc(Desc) then
  289.           if AddString(GetItemStr(DescStr, Desc, Sel)) = -1 then ;
  290.             {ignores errors}
  291.     end;
  292.     SetCursor(OldCursor);
  293.   end;
  294.  
  295.   procedure LDTWindow.SetupWindow;
  296.     {-Set the ansi fixed font}
  297.   begin
  298.     TWindow.SetupWindow;
  299.     SendMessage(LDTLB^.HWindow, wm_SetFont, GetStockObject(Ansi_Fixed_Font), 0);
  300.   end;
  301.  
  302.   procedure LDTWindow.WMActivateApp(var Msg : TMessage);
  303.     {-Rebuild list each time focus is received by application}
  304.   begin
  305.     if Msg.wParam > 0 then
  306.       LDTLB^.BuildList;
  307.   end;
  308.  
  309.   procedure LDTWindow.wmSetFocus(var Msg : TMessage);
  310.   begin
  311.     {give the focus to the list box}
  312.     SetFocus(LDTLB^.hWindow);
  313.   end;
  314.  
  315.   procedure LDTWindow.wmSize(var Msg : TMessage);
  316.     {-Handle resizing}
  317.   begin
  318.     TWindow.wmSize(Msg);
  319.     {resize list box to fill client area of parent}
  320.     SetWindowPos(LDTLB^.hWindow, 0, 0, 0, Msg.lParamLo, Msg.lParamHi, swp_NoZOrder);
  321.   end;
  322.  
  323.   procedure DumpLDTApplication.InitMainWindow;
  324.     {-Init our list box window}
  325.   begin
  326.     MainWindow := New(PLDTWindow, Init(nil, 'Dump LDT'));
  327.   end;
  328.  
  329. begin {main}
  330.   LDTApp.Init('Dump LDT');
  331.   LDTApp.Run;
  332.   LDTApp.Done;
  333. end.
  334.